(*--------------------------------------------------------
    Holt                  http://coderesearchlabs.com/holt
    by Javier Santo Domingo (j-a-s-d@coderesearchlabs.com)
  --------------------------------------------------------
    emission
  --------------------------------------------------------*)

unit holt_emission;

{$I holt_defines.inc}

interface

uses
  holt_architecture,
  holt_types;

function NewEmissionController: IhEmissionController;

implementation

uses
  holt_consts,
  dynlibs;

{ ThEmitter }

type
  ThEmitter = class(TInterfacedObject, IhEmitter)
  strict private
    FPath: gString;
    FFilename: gString;
    FLastResult: gString;
    FHandle: TLibHandle;
    FLoadedLibrary: gBoolean;
    FLoadedRoutines: gBoolean;
    FEnabled: gBoolean;
    FName: gString;
    FGetName: ThEmitterGetName;
    FGetLevelKinds: ThEmitterGetLevelKinds;
    FSetDestination: ThEmitterSetDestination;
    FBeginEmission: ThEmitterEndEmission;
    FEndEmission: ThEmitterEndEmission;
    FEmitNode: ThEmitterEmitNode;
  strict protected
    function Load: gBoolean;
    procedure Unload;
    procedure Reset;
    procedure Disable;
    function IsReady: gBoolean;
    function GetReadinessStatus: gString;
    function Emit(ATree: IhTree; const ADestination: gString): gBoolean;
    function GetLastResult: gString;
    function GetName: gString;
    function GetLevelKinds(ALevel: gNumber): gString;
    function SetDestination(const ADestination: gString): gBoolean;
    function BeginEmission: gBoolean;
    function EndEmission: gBoolean;
	  function EmitNode(ALevel, APosition, AChildCount: gNumber;
      const APath, AKind, AName, AValue: gString): gBoolean;
    procedure Initialize(const AEmitterFile: gString);
  public
    procedure BeforeDestruction; override;
  end;

procedure ThEmitter.BeforeDestruction;
begin
  Unload;
  inherited;
end;

procedure ThEmitter.Initialize(const AEmitterFile: gString);
begin
  FFilename := AEmitterFile + '.' + dynlibs.SharedSuffix;
  getdir(0, FPath);
  FPath += DirectorySeparator + SUBDIRECTORY_EMITTERS + DirectorySeparator;
  Reset;
end;

procedure ThEmitter.Reset;
begin
  FEnabled := true;
  if Load then
    FName := FGetName();
  Unload;
end;

function ThEmitter.Load: gBoolean;

  function loadRoutines: gBoolean; inline;
  begin
    FGetName := ThEmitterGetName(dynlibs.GetProcedureAddress(FHandle, 'getName'));
    FGetLevelKinds := ThEmitterGetLevelKinds(dynlibs.GetProcedureAddress(FHandle, 'getLevelKinds'));
    FSetDestination := ThEmitterSetDestination(dynlibs.GetProcedureAddress(FHandle, 'setDestination'));
    FBeginEmission := ThEmitterBeginEmission(dynlibs.GetProcedureAddress(FHandle, 'beginEmission'));
    FEndEmission := ThEmitterEndEmission(dynlibs.GetProcedureAddress(FHandle, 'endEmission'));
    FEmitNode := ThEmitterEmitNode(dynlibs.GetProcedureAddress(FHandle, 'emitNode'));
    result := assigned(FGetName) and
      assigned(FGetLevelKinds) and
      assigned(FSetDestination) and
      assigned(FBeginEmission) and
      assigned(FEndEmission) and
      assigned(FEmitNode);
  end;

begin
  FHandle := dynlibs.LoadLibrary(FPath + FFilename);
  FLoadedLibrary := FHandle <> dynlibs.nilHandle;
  if FLoadedLibrary then
    FLoadedRoutines := loadRoutines;
  result := FLoadedLibrary and FLoadedRoutines;
end;

procedure ThEmitter.Unload;

  procedure clearRoutines; inline;
  begin
    FGetName := nil;
    FGetLevelKinds := nil;
    FSetDestination := nil;
    FBeginEmission := nil;
    FEndEmission := nil;
    FEmitNode := nil;
  end;

begin
{$IFNDEF LINUX}
  dynlibs.UnloadLibrary(FHandle);
{$ENDIF}
  clearRoutines;
end;

function ThEmitter.IsReady: gBoolean;
begin
  result := FLoadedLibrary and FLoadedRoutines and FEnabled;
end;

procedure ThEmitter.Disable;
begin
  FEnabled := false;
end;

function ThEmitter.GetReadinessStatus: gString;
begin
  if FLoadedLibrary and FLoadedRoutines then begin
    result := FName + ' <' + FFilename + '> -- ';
    if FEnabled then
      result += MSG_OK
    else
      result += MSG_DISABLED;
  end else begin
    result := '?' + ' <' + FFilename + '> -- ';
    if not FLoadedLibrary then
      result += MSG_LOAD_LIBRARY_FAILED
    else //if not FLoadedRoutines then
      result += MSG_LOAD_ROUTINES_FAILED;
  end;
end;

function ThEmitter.GetName: gString;
begin
  result := FName;
end;

function ThEmitter.GetLevelKinds(ALevel: gNumber): gString;
begin
  FLastResult := FGetLevelKinds(ALevel);
  result := FLastResult;
end;

function ThEmitter.EmitNode(ALevel, APosition, AChildCount: gNumber;
  const APath, AKind, AName, AValue: gString): gBoolean;
begin
  FLastResult := FEmitNode(ALevel, APosition, AChildCount,
    pchar(APath), pchar(AKind), pchar(AName), pchar(AValue));
  result := FLastResult = EMITTER_OK;
end;

function ThEmitter.SetDestination(const ADestination: gString): gBoolean;
begin
  FLastResult := FSetDestination(pchar(ADestination));
  result := FLastResult = EMITTER_OK;
end;

function ThEmitter.BeginEmission: gBoolean;
begin
  FLastResult := FBeginEmission();
  result := FLastResult = EMITTER_OK;
end;

function ThEmitter.EndEmission: gBoolean;
begin
  FLastResult := FEndEmission();
  result := FLastResult = EMITTER_OK;
end;

function ThEmitter.Emit(ATree: IhTree; const ADestination: gString): gBoolean;

  function emittingRecursion(ATreeNode: IhTreeNode): gBoolean;
  var index, count: gNumber;
  begin
    result := ATreeNode <> nil;
    if result then
      with ATreeNode do begin
        count := GetChildNodesCount;
        result := result and EmitNode(GetLevel, GetPosition, count,
          GetPath, GetKind, GetName, GetValue);
        if count > 0 then
          for index := 0 to count - 1 do
            result := result and EmittingRecursion(GetChild(index));
      end;
  end;

begin
  result := IsReady
    and SetDestination(ADestination)
    and BeginEmission
    and emittingRecursion(ATree.GetCurrentNode)
    and EndEmission;
end;

function ThEmitter.GetLastResult: gString;
begin
  result := FLastResult;
end;

function NewEmitter(const AEmitterFile: gString): IhEmitter;
begin
  result := ThEmitter.Create;
  result.Initialize(AEmitterFile);
end;

{ ThEmissionController }

type
  ThEmitters = array of IhEmitter;

  ThEmissionController = class(TInterfacedObject, IhEmissionController)
  strict private
    FCurrentEmitter: IhEmitter;
    FEmitters: ThEmitters;
    function LoadFromFile(const AFilename: gString): gBoolean;
    procedure UnloadEmitters;
  strict protected
    function LoadEmitter(const AEmitterFile: gString): gBoolean;
    function ReloadEmitter(const AEmitterName: gString): gBoolean;
    function SetCurrentEmitter(const AEmitterName: gString): gBoolean;
    function GetCurrentEmitter: IhEmitter;
    function GetEmittersList: gString;
  public
    procedure BeforeDestruction; override;
  end;

procedure ThEmissionController.BeforeDestruction;
begin
  FCurrentEmitter := nil;
  UnloadEmitters;
  inherited;
end;

function ThEmissionController.GetEmittersList: gString;
var index: gNumber;
begin
  result := '';
  if Length(FEmitters) > 0 then
    for index := 0 to Length(FEmitters)-1 do
      result += FEmitters[index].GetReadinessStatus + LineEnding;
end;

function ThEmissionController.GetCurrentEmitter: IhEmitter;
begin
  result := FCurrentEmitter;
end;

function ThEmissionController.SetCurrentEmitter(const AEmitterName: gString): gBoolean;
var index: gNumber;
begin
  result := false;
  if Length(FEmitters) > 0 then
    for index := 0 to Length(FEmitters)-1 do
      if FEmitters[index].GetName = AEmitterName then begin
        if assigned(FCurrentEmitter) then
          FCurrentEmitter.Unload;
        FCurrentEmitter := FEmitters[index];
        result := FCurrentEmitter.Load;
        break;
      end;
end;

function ThEmissionController.LoadFromFile(const AFilename: gString): gBoolean;
var ft: gTextFile; emitterFile: gString;
begin
  assignfile(ft, AFilename);
  {$I-}reset(ft);{$I+}
  result := ioresult = 0;
  if result then
  try
    while not eof(ft) do begin
      readln(ft, emitterFile);
      LoadEmitter(emitterFile);
    end;
  finally
    close(ft);
  end;
end;

function ThEmissionController.LoadEmitter(const AEmitterFile: gString): gBoolean;

  procedure computeNameClashValidation(AEmitter: IhEmitter); inline;
  var index: gNumber;
  begin
    for index := 0 to Length(FEmitters)-1 do
      if assigned(FEmitters[index]) then
        if FEmitters[index] <> AEmitter then
          if FEmitters[index].GetName = AEmitter.GetName then begin
            AEmitter.Disable;
            break;
          end;
  end;

var index: gNumber;
begin
  result := true;
  try
    index := Length(FEmitters);
    SetLength(FEmitters, index+1);
    FEmitters[index] := NewEmitter(AEmitterFile);
    computeNameClashValidation(FEmitters[index]);
  except
    result := false;
  end;
end;

function ThEmissionController.ReloadEmitter(const AEmitterName: gString): gBoolean;
var index: gNumber;
begin
  result := false;
  if Length(FEmitters) > 0 then
    for index := 0 to Length(FEmitters)-1 do
      with FEmitters[index] do begin
        result := (GetName = AEmitterName) and IsReady;
        if result then begin
          if FEmitters[index] = FCurrentEmitter then begin
            Unload;
            Load;
          end else
            Reset;
          break;
        end;
      end;
end;

procedure ThEmissionController.UnloadEmitters;
var index: gNumber;
begin
  if Length(FEmitters) > 0 then
    for index := 0 to Length(FEmitters)-1 do
      if assigned(FEmitters[index]) then
        FEmitters[index] := nil;
end;

function NewEmissionController: IhEmissionController;
begin
  result := ThEmissionController.Create;
end;

end.
